home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / Foxpro 2.6 {Windows} / CPZERO.PR_ / CPZERO.bin
Text File  |  1994-03-10  |  4KB  |  167 lines
  1. * CPZERO -- Poke a codepage byte into a database header
  2. * Author: Walter Kennamer
  3. * Copyright Microsoft Corp, 1993
  4. *
  5. * Usage: 
  6. *    DO CPZERO WITH dbfname                     && marks the database with codepage 0 (i.e., no codepage)
  7. * 
  8. *    DO CPZERO WITH dbfname, codepage_number    && marks the database with specified codepage
  9. *
  10. * Some common valid numbers are:
  11. *   Windows            1252
  12. *   DOS                 437
  13. *   International DOS   850
  14. *
  15.  
  16. PARAMETER m.fname, m.cpbyte
  17. IF SET("TALK") = "ON"
  18.    SET TALK OFF
  19.    m.mtalk = "ON"
  20. ELSE
  21.    m.mtalk = "OFF"
  22. ENDIF   
  23.  
  24. #define C_TOTAL 20     && total code page numbers suppoted
  25.  
  26. IF PARAMETERS() < 2
  27.    m.cpbyte = 0
  28. ENDIF   
  29.  
  30. PRIVATE m.mtalk, m.vuename
  31.  
  32. #define c_buf_size 32
  33.  
  34. #define c_noopen   1
  35. #define c_badbyte  2
  36. #define c_notfox   3
  37. #define c_maxerror 4
  38.  
  39. m.vuename = ""
  40.  
  41. DECLARE error_array[c_maxerror]
  42. error_array[c_noopen] = "The database could not be opened."
  43. error_array[c_badbyte] = "Invalid code page specified."
  44. error_array[c_notfox] = "Not a FoxPro table."
  45.  
  46. DO setup
  47. DO main
  48. DO cleanup
  49.  
  50. PROCEDURE setup
  51. m.vuename = SYS(2023)+"\"+SYS(3)+".VUE"
  52. CREATE VIEW (m.vuename)
  53.  
  54.  
  55. PROCEDURE cleanup
  56. IF FILE(m.vuename)
  57.    SET VIEW TO (m.vuename)
  58.    DELETE FILE (m.vuename)
  59. ENDIF   
  60. SET TALK &mtalk
  61.  
  62. PROCEDURE main
  63. PRIVATE m.fp_in, m.buf, m.found_one, m.i, m.outbyte
  64.  
  65. * Set up table of code pages and DBF bytes numbers
  66. DIMENSION cpnums[C_TOTAL,2] 
  67. cpnums[ 1,1] = 437
  68. cpnums[ 1,2] = 1
  69. cpnums[ 2,1] = 850
  70. cpnums[ 2,2] = 2
  71. cpnums[ 3,1] = 1252
  72. cpnums[ 3,2] = 3
  73. cpnums[ 4,1] = 10000
  74. cpnums[ 4,2] = 4
  75. cpnums[ 5,1] = 852
  76. cpnums[ 5,2] = 100
  77. cpnums[ 6,1] = 866
  78. cpnums[ 6,2] = 101
  79. cpnums[ 7,1] = 865
  80. cpnums[ 7,2] = 102
  81. cpnums[ 8,1] = 861
  82. cpnums[ 8,2] = 103
  83. cpnums[ 9,1] = 895
  84. cpnums[ 9,2] = 104
  85. cpnums[10,1] = 620
  86. cpnums[10,2] = 105
  87. cpnums[11,1] = 737
  88. cpnums[11,2] = 106
  89. cpnums[12,1] = 857
  90. cpnums[12,2] = 107
  91. cpnums[13,1] = 10007
  92. cpnums[13,2] = 150
  93. cpnums[14,1] = 10029
  94. cpnums[14,2] = 151
  95. cpnums[15,1] = 10006
  96. cpnums[15,2] = 152
  97. cpnums[16,1] = 1250
  98. cpnums[16,2] = 200
  99. cpnums[17,1] = 1251
  100. cpnums[17,2] = 201
  101. cpnums[18,1] = 1253
  102. cpnums[18,2] = 203
  103. cpnums[19,1] = 1254
  104. cpnums[19,2] = 202
  105. cpnums[20,1] = 0
  106. cpnums[20,2] = 0
  107.  
  108. IF EMPTY(m.fname)
  109.    m.fname = getfile("DBF|SCX|FRX|LBX|MNX","DBF name")
  110. ENDIF
  111. IF !EMPTY(m.fname)
  112.    CLOSE DATABASES
  113.    m.outbyte = m.cpbyte
  114.    m.found_one = .F.
  115.    FOR m.i = 1 TO C_TOTAL
  116.       IF m.cpbyte = cpnums[m.i,1]
  117.          m.outbyte = cpnums[m.i,2]
  118.          m.found_one = .T.
  119.          EXIT
  120.       ENDIF
  121.    ENDFOR
  122.    IF m.found_one
  123.       m.cpbyte = m.outbyte
  124.    ELSE
  125.       * Was it a valid DBF byte if it wasn't a valid code page?
  126.       FOR m.i = 1 TO C_TOTAL
  127.          IF m.cpbyte = cpnums[m.i,2]
  128.             m.found_one = .T.
  129.          ENDIF
  130.       ENDFOR
  131.       IF !m.found_one
  132.          DO errormsg WITH c_badbyte
  133.          RETURN TO cpzero
  134.       ENDIF
  135.    ENDIF
  136.    
  137.    IF FILE(m.fname)
  138.        m.fp_in = FOPEN(m.fname,2)
  139.        IF m.fp_in > 0
  140.           * First check that we have a FoxPro table...
  141.           m.buf=FREAD(m.fp_in,c_buf_size)
  142.           IF (SUBSTR(m.buf,1,1) = CHR(139) OR SUBSTR(m.buf,1,1) = CHR(203);
  143.              OR SUBSTR(m.buf,31,1) != CHR(0) OR SUBSTR(m.buf,32,1) != CHR(0))
  144.               =fclose(m.fp_in)
  145.               DO errormsg WITH c_notfox
  146.               RETURN TO cpzero
  147.           ELSE
  148.               * Now poke the codepage id into byte 29
  149.               =FSEEK(m.fp_in,29)
  150.               =FWRITE(m.fp_in,CHR(m.cpbyte)) 
  151.               =FCLOSE(m.fp_in)
  152.           ENDIF
  153.        ELSE
  154.           DO errormsg WITH c_noopen
  155.           RETURN TO cpzero
  156.        ENDIF
  157.     ELSE
  158.        DO errormsg WITH c_noopen
  159.        RETURN TO cpzero
  160.     ENDIF
  161. ENDIF      
  162.  
  163.  
  164. PROCEDURE errormsg
  165. PARAMETER num
  166. WAIT WINDOW error_array[num] NOWAIT
  167.